home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #4 / Amiga Plus CD - 2000 - No. 4.iso / Tools / Dev / powerd / source / examples / Flare.d < prev    next >
Encoding:
Text File  |  2000-02-24  |  7.2 KB  |  311 lines
  1. // flare.d - simple lens flare renderer, it generates 24bit result in ram:flares.tga file
  2.  
  3. MODULE    'intuition/intuition','intuition/screens','graphics/modeid','exec/memory',
  4.             'utility/tagitem'
  5.  
  6. CONST    W=320,H=240
  7.  
  8. PROC main()
  9.     DEF    flist:PTR TO flare,r,x,y
  10.     //
  11.     // flare definition
  12.     //
  13.     flist:=[
  14.         FL_Linear    , 50.0, 0.00,1.00,1.00,1.00,
  15.         FL_Power        , 60.0, 0.00,0.00,0.30,1.00,
  16.         FL_FadeRing    , 30.0,-0.10,0.20,0.00,0.00,
  17.         FL_Circle    , 10.0, 0.20,0.10,0.15,0.10,
  18.         FL_Ring        , 34.0, 0.25,0.15,0.10,0.10,
  19.         FL_Circle    , 20.0, 0.30,0.10,0.10,0.20,
  20.         FL_Circle    , 14.0, 0.40,0.10,0.10,0.10,
  21.         FL_Power        ,  2.0, 0.47,0.10,0.70,1.00,
  22.         FL_Circle    ,  4.0, 0.55,0.10,0.10,0.10,
  23.         FL_Circle    , 26.0, 0.60,0.10,0.10,0.20,
  24.         FL_Circle    , 12.0, 0.70,0.10,0.20,0.10,
  25.         FL_Linear    , 16.0, 0.85,0.00,0.10,0.40,
  26.         FL_FadeRing    ,100.0, 1.00,0.30,0.05,0.00,
  27.         FL_FadeRing    ,200.0, 1.50,0.05,0.20,0.10,
  28.         FL_Last]:flare
  29.     PrintF('Flare by MarK 23.2.2000\n')
  30.     PrintF('Press:\n\tLMB to change light position\n\tRMB to render flares\n\tany key for exit\n')
  31.     r,x,y:=Preview(flist)
  32.     IF r THEN Render(flist,x,y)
  33. ENDPROC
  34.  
  35. ENUM    FL_Last,
  36.         FL_Linear,
  37.         FL_Power,
  38.         FL_Circle,
  39.         FL_Ring,
  40.         FL_FadeRing
  41.  
  42. OBJECT flare
  43.     type:LONG,        // type of the flare (see FL... above)
  44.     size:FLOAT,        // size of the flare
  45.     pos:FLOAT,        // position on the flare line (0=light, 1.0=opposite the light)
  46.     r:FLOAT,            // colour of the flare
  47.     g:FLOAT,
  48.     b:FLOAT
  49.  
  50. //
  51. // preview and setup for rendering
  52. //
  53. PROC Preview(flist:PTR TO flare)(LONG,LONG,LONG)
  54.     DEF    s:PTR TO Screen,w:PTR TO Window,m:PTR TO IntuiMessage,end=FALSE,r=FALSE,mx,my
  55.     IF s:=OpenScreenTags(NIL,
  56.             SA_Width,W,
  57.             SA_Height,H,
  58.             SA_Depth,1,
  59.             SA_DisplayID,VGALORESDBL_KEY,
  60.             SA_Colors,[0,0,0,0,1,15,15,15,-1]:WORD,
  61.             TAG_END)
  62.         IF w:=OpenWindowTags(NIL,
  63.                 WA_Width,W,
  64.                 WA_Height,H,
  65.                 WA_CustomScreen,s,
  66.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  67.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  68.                 TAG_END)
  69.             SetAPen(w.RPort,1)
  70.             DrawFlare(w.RPort,flist,w.MouseX,w.MouseY)
  71.             mx:=w.MouseX
  72.             my:=w.MouseY
  73.             WHILE WaitPort(w.UserPort)
  74.                 IF m:=GetMsg(w.UserPort)
  75.                     IF m.Class=IDCMP_MOUSEBUTTONS
  76.                         IF m.Code=SELECTDOWN
  77.                             SetRast(w.RPort,0)
  78.                             DrawFlare(w.RPort,flist,mx:=w.MouseX,my:=w.MouseY)
  79.                         ELSEIF m.Code=MENUDOWN
  80.                             r:=TRUE
  81.                             end:=TRUE
  82.                         ENDIF
  83.                     ELSE
  84.                         end:=TRUE
  85.                     ENDIF
  86.                     ReplyMsg(m)
  87.                 ENDIF
  88.             EXITIF end=TRUE
  89.             ENDWHILE
  90.  
  91. //            WaitPort(w.UserPort)
  92.             CloseWindow(w)
  93.         ELSE PrintF('Unable to open window!\n')
  94.         CloseScreen(s)
  95.     ELSE PrintF('Unable to open screen!\n')
  96. ENDPROC r,mx,my
  97.  
  98. //
  99. // draw circles as flares
  100. //
  101. PROC DrawFlare(rp,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  102.     DEFF    cx,cy,dx,dy,x,y
  103.     cx:=W/2
  104.     cy:=H/2
  105.     dx:=cx-mx
  106.     dy:=cy-my
  107.     REPEAT
  108.         x:=-dx*(flist.pos*2.0-1.0)
  109.         y:=-dy*(flist.pos*2.0-1.0)
  110. //        PrintF('x=$\z\h[8]\ny=$\z\h[8]\n',x,y)
  111.         DrawEllipse(rp,x+cx,y+cy,flist.size/2,flist.size/2)
  112.         flist[]++
  113.     UNTIL flist.type=FL_Last
  114. ENDPROC
  115.  
  116. //
  117. // open output screen and window
  118. //
  119. PROC Render(flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  120.     DEF    s:PTR TO Screen,w:PTR TO Window,vp,n,image:PTR TO RImage
  121.     IF s:=OpenScreenTags(NIL,
  122.             SA_Width,W,
  123.             SA_Height,H,
  124.             SA_Depth,8,
  125.             SA_DisplayID,VGALORESDBL_KEY,
  126.             TAG_END)
  127.         IF w:=OpenWindowTags(NIL,
  128.                 WA_Width,W,
  129.                 WA_Height,H,
  130.                 WA_CustomScreen,s,
  131.                 WA_IDCMP,IDCMP_MOUSEBUTTONS|IDCMP_VANILLAKEY,
  132.                 WA_Flags,WFLG_RMBTRAP|WFLG_ACTIVATE|WFLG_BORDERLESS,
  133.                 TAG_END)
  134.             vp:=ViewPortAddress(w)
  135.             FOR n:=0 TO 255 SetRGB32(vp,n,n<<24,n<<24,n<<24)
  136.             SetAPen(w.RPort,255)
  137.  
  138.             IF image:=NewImage(W,H)
  139. //                DrawFlare(w.RPort,flist,mx,my)
  140.                 RenderFlare(w.RPort,image,flist,mx,my)
  141.                 SaveTarga(image)
  142.                 DeleteImage(image)
  143.             ENDIF
  144.  
  145.             WaitPort(w.UserPort)
  146.             CloseWindow(w)
  147.         ELSE PrintF('Unable to open window!\n')
  148.         CloseScreen(s)
  149.     ELSE PrintF('Unable to open screen!\n')
  150. ENDPROC
  151.  
  152. //
  153. // render flare list
  154. //
  155. PROC RenderFlare(rp,im,flist:PTR TO flare,mx:FLOAT,my:FLOAT)
  156.     DEFF    cx,cy,dx,dy,x,y,xx,yy,i,sx,sy
  157.     cx:=W/2
  158.     cy:=H/2
  159.     dx:=cx-mx
  160.     dy:=cy-my
  161.     REPEAT
  162.         x:=-dx*(flist.pos*2.0-1.0)
  163.         y:=-dy*(flist.pos*2.0-1.0)
  164.         sx:=x-flist.size/2
  165. //        IF sx<-cx THEN sx:=-cx
  166.         FOR xx:=sx TO x+flist.size/2
  167.         EXITIF xx>=cx
  168.             sy:=y-flist.size/2
  169. //            IF sy<-cy THEN sy:=-cy
  170.             FOR yy:=sy TO y+flist.size/2
  171.             EXITIF yy>=cy
  172.                 i:=Flare(flist,xx,yy,x,y)
  173.                 SetAPen(rp,RRePlot(im,xx+cx,yy+cy,i*flist.r,i*flist.g,i*flist.b))
  174.                 WritePixel(rp,xx+cx,yy+cy)
  175.             ENDFOR
  176.             IF Mouse()=3 THEN RETURN
  177.         ENDFOR
  178.         flist[]++
  179.     UNTIL flist.type=FL_Last
  180. ENDPROC
  181.  
  182. //
  183. // get flare intensity
  184. //
  185. PROC Flare(flare:PTR TO flare,x:FLOAT,y:FLOAT,fx:FLOAT,fy:FLOAT)(FLOAT)
  186.     DEFF    i,l
  187.     x-=fx
  188.     y-=fy
  189.     l:=Sqrt(x*x+y*y)                    // l = distance of rendering pixel and flare center
  190.     l/=flare.size/2.0                    // unify
  191. //    l*=2
  192.     IF l>1.0 THEN RETURN 0.0        // no intersection, end
  193.     SELECT flare.type
  194.     CASE FL_Linear
  195.         i:=1.0-l
  196.     CASE FL_Power
  197.         i:=(1.0-l)*(1.0-l)
  198.     CASE FL_Circle
  199.         IF l>0.95
  200. //            i:=20.0*(1.0-l)
  201.             i:=(1.0-l)*20.0
  202.         ELSE
  203.             i:=1.0
  204.         ENDIF
  205.     CASE FL_Ring
  206.         IF l>0.90
  207.             i:=(1.0-l)*10.0
  208.         ELSEIF l>0.80
  209.             i:=(l-0.80)*10.0
  210.         ELSE
  211.             i:=0.0
  212.         ENDIF
  213.     CASE FL_FadeRing
  214.         IF l>0.95
  215.             i:=(1.0-l)*20.0
  216.         ELSEIF l>0.50
  217.             i:=(l-0.50)*2.0
  218.         ELSE
  219.             i:=0.0
  220.         ENDIF
  221.     DEFAULT
  222.         i:=0.0
  223.     ENDSELECT
  224.     IF i>1.0 THEN i:=1.0
  225.     IF i<0.0 THEN i:=0.0
  226. ENDPROC i
  227.  
  228. //
  229. // image definition
  230. //
  231. OBJECT RGB
  232.     r:UBYTE,
  233.     g:UBYTE,
  234.     b:UBYTE
  235.  
  236. OBJECT BGR                    // for targa saving
  237.     b:UBYTE,
  238.     g:UBYTE,
  239.     r:UBYTE
  240.  
  241. OBJECT RImage
  242.     Width:LONG,
  243.     Height:LONG,
  244.     Pixel:PTR TO RGB
  245.  
  246. PROC NewImage(w,h)(PTR TO RImage)
  247.     DEF    image:PTR TO RImage
  248.     IF (image:=AllocMem(SIZEOF_RImage,MEMF_PUBLIC|MEMF_CLEAR))=NIL THEN RETURN NIL
  249.     image.Width:=w
  250.     image.Height:=h
  251.     IF (image.Pixel:=AllocMem(SIZEOF_RGB*w*h,MEMF_PUBLIC|MEMF_CLEAR))=NIL
  252.         FreeMem(image,SIZEOF_RImage)
  253.         RETURN NIL
  254.     ENDIF
  255. ENDPROC image
  256.  
  257. PROC RRePlot(image:PTR TO RImage,x,y,r:FLOAT,g:FLOAT,b:FLOAT)(LONG=0)
  258.     DEF    c,pixel:PTR TO RGB
  259.     IF x>=image.Width OR y>=image.Height OR x<0 OR y<0 THEN RETURN
  260.     r*=255
  261.     g*=255
  262.     b*=255
  263.     pixel:=image.Pixel[y*image.Width+x]
  264.  
  265.     r+=pixel.r
  266.     g+=pixel.g
  267.     b+=pixel.b
  268.  
  269.     IF r>255 THEN r:=255
  270.     IF g>255 THEN g:=255
  271.     IF b>255 THEN b:=255
  272.  
  273.     pixel.r:=r
  274.     pixel.g:=g
  275.     pixel.b:=b
  276.     c:=(pixel.r+pixel.g+pixel.b)/3
  277. ENDPROC c
  278.  
  279. PROC DeleteImage(image:PTR TO RImage)
  280.     IF image.Pixel THEN FreeMem(image.Pixel,image.Width*image.Height*SIZEOF_RGB)
  281.     FreeMem(image,SIZEOF_RImage)
  282. ENDPROC
  283.  
  284. //
  285. // save 24bit targa image
  286. //
  287. PROC SaveTarga(image:PTR TO RImage)
  288.     DEF    buff:PTR TO BGR,f,x,y,length,comment:PTR TO CHAR
  289.     PrintF('Saving...\b')
  290.     IF buff:=AllocMem(image.Width*image.Height*SIZEOF_BGR,MEMF_PUBLIC)
  291.         FOR y:=0 TO image.Height-1
  292.             FOR x:=0 TO image.Width-1
  293.                 buff[y*image.Width+x].r:=image.Pixel[y*image.Width+x].r
  294.                 buff[y*image.Width+x].g:=image.Pixel[y*image.Width+x].g
  295.                 buff[y*image.Width+x].b:=image.Pixel[y*image.Width+x].b
  296.             ENDFOR
  297.         ENDFOR
  298.         IF f:=Open('ram:flares.tga',NEWFILE)
  299.             comment:='$VER:This picture is generated by Martin Kuchinka''s simple Flare renderer.'
  300.             length:=StrLen(comment)
  301.             Write(f,[length,0,2,0,0,0,0,24,0,0,0,0,image.Width,image.Width>>8,image.Height,image.Height>>8,24,$20]:UBYTE,18)
  302.             Write(f,comment,length)
  303.             Write(f,buff,image.Width*image.Height*SIZEOF_BGR)
  304. //            Write(f,image.Pixel,image.Width*image.Height*SIZEOF_BGR)
  305.             PrintF('Done.     \n')
  306.             Close(f)
  307.         ELSE PrintF('Unable to write image!\n')
  308.         FreeMem(buff,image.Width*image.Height*SIZEOF_BGR)
  309.     ELSE PrintF('Not enough memory!\n')
  310. ENDPROC
  311.